Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vblha1/frmlha.frm

Text File | 1995-05-08 | 10KB | 467 lines

VERSION 2.00
Begin Form frmlha
   AutoRedraw      =   -1  'True
   Caption         =   "LHA file contents"
   Height          =   4440
   Left            =   825
   LinkTopic       =   "Form1"
   ScaleHeight     =   4035
   ScaleWidth      =   3315
   Top             =   1185
   Width           =   3435
   Begin CommandButton cmdVersion
      Caption         =   "LHA &Version"
      Height          =   495
      Left            =   2040
      TabIndex        =   7
      Top             =   1440
      Width           =   1095
   End
   Begin PictureBox picFile2
      Height          =   615
      Left            =   3720
      Picture         =   FRMLHA.FRX:0000
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   6
      Top             =   960
      Width           =   495
   End
   Begin PictureBox PicFile1
      Height          =   615
      Left            =   3720
      Picture         =   FRMLHA.FRX:0302
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   5
      Top             =   240
      Width           =   495
   End
   Begin CommandButton cmdDelete
      Caption         =   "&Delete"
      Height          =   495
      Left            =   2040
      TabIndex        =   4
      Top             =   3240
      Width           =   1095
   End
   Begin CommandButton cmdExtract
      Caption         =   "&Extract"
      Height          =   495
      Left            =   2040
      TabIndex        =   3
      Top             =   2040
      Width           =   1095
   End
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   495
      Left            =   2040
      TabIndex        =   2
      Top             =   840
      Width           =   1095
   End
   Begin CommandButton cmdOK
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   495
      Left            =   2040
      TabIndex        =   1
      Top             =   240
      Width           =   1095
   End
   Begin ListBox lstLHAcontents
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Terminal"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   3540
      Left            =   240
      MultiSelect     =   2  'ègÆú
      TabIndex        =   0
      Top             =   240
      Width           =   1575
   End
End
Sub cmdCancel_Click ()

' set the frmlha.tag to null
  frmLHA.Tag = ""

' hide the frmlha
frmLHA.Hide

End Sub

'Copyright 1995 by Hitoshi Ozawa
Sub cmdDelete_Click ()

Dim retcode As Integer
Dim curpath As String
Dim cnt
Dim numitem

'Reset buffer size
buffer = Space(szbuff)

'Save current path
curpath = CurDir

ChDrive Mid$(frmgetfile.Tag, 1, 2)
ChDir frmgetfile.filFiles.Path

numitem = lstLHAcontents.ListCount
cnt = 0
Do While cnt < numitem
 If lstLHAcontents.Selected(cnt) Then
   'Create LHA command
   cmd = "d " & frmgetfile.Tag & " " & lstLHAcontents.List(cnt)

   'Perform LHA operation
    retcode = lha(cmd, buffer, szbuff)

   'Check for error
   If retcode <> 0 Then
     MsgBox ("Error: " & retcode)
     Exit Sub
   End If
   lstLHAcontents.RemoveItem cnt
   numitem = numitem - 1
 Else
   cnt = cnt + 1
 End If
Loop

'Return to original drive
ChDrive Mid$(curpath, 1, 2)

'Return to original path
ChDir curpath

End Sub

'Copyright 1995 by Hitoshi Ozawa
Sub cmdDelete_DragDrop (Source As Control, X As Single, Y As Single)

Dim retcode As Integer
Dim curpath As String
Dim cnt
Dim numitem

'Save current path
curpath = CurDir

ChDrive Mid$(frmgetfile.Tag, 1, 2)
ChDir frmgetfile.filFiles.Path

numitem = lstLHAcontents.ListCount
cnt = 0
Do While cnt < numitem
 If lstLHAcontents.Selected(cnt) Then
   'Create LHA command
   cmd = "d " & frmgetfile.Tag & " " & lstLHAcontents.List(cnt)

   'Perform LHA operation
    retcode = lha(cmd, buffer, szbuff)

   'Check for error
   If retcode <> 0 Then
     MsgBox ("Error: " & retcode)
     Exit Sub
   End If
   lstLHAcontents.RemoveItem cnt
   numitem = numitem - 1
 Else
   cnt = cnt + 1
 End If
Loop

'Return to original drive
ChDrive Mid$(curpath, 1, 2)

'Return to original path
ChDir curpath

End Sub

'Copyright 1995 by Hitoshi Ozawa
Sub cmdDelete_DragOver (Source As Control, X As Single, Y As Single, State As Integer)

Select Case State
  Case 0
    'change icon to release
     lstLHAcontents.DragIcon = picFile2
  Case 1
    'change icon to release
     lstLHAcontents.DragIcon = picFile1
End Select

End Sub

'Copyright 1995 by Hitoshi Ozawa
Sub cmdExtract_Click ()

Dim retcode As Integer
Dim curpath As String
Dim cnt

'Reset buffer size
buffer = Space(szbuff)

'Save current path
curpath = CurDir

ChDrive Mid$(frmgetfile.Tag, 1, 2)
ChDir frmgetfile.filFiles.Path

For cnt = 0 To lstLHAcontents.ListCount - 1
 If lstLHAcontents.Selected(cnt) Then
   'Create LHA command
   cmd = "e " & frmgetfile.Tag & " " & lstLHAcontents.List(cnt)

   'Perform LHA operation
    retcode = lha(cmd, buffer, szbuff)

   'Check for error
   If retcode <> 0 Then
     MsgBox ("Error: " & retcode)
     Exit Sub
   End If
 End If
Next cnt

'Return to original drive
ChDrive Mid$(curpath, 1, 2)

'Return to original path
ChDir curpath

'refresh getfile file box
frmgetfile.filFiles.Refresh

End Sub

'Copyright 1995 by Hitoshi Ozawa
Sub cmdExtract_DragDrop (Source As Control, X As Single, Y As Single)

Dim retcode As Integer
Dim curpath As String
Dim cnt

'Save current path
curpath = CurDir

ChDrive Mid$(frmgetfile.Tag, 1, 2)
ChDir frmgetfile.filFiles.Path

For cnt = 0 To lstLHAcontents.ListCount - 1
 If lstLHAcontents.Selected(cnt) Then
   'Create LHA command
   cmd = "e " & frmgetfile.Tag & " " & lstLHAcontents.List(cnt)

   'Perform LHA operation
    retcode = lha(cmd, buffer, szbuff)

   'Check for error
   If retcode <> 0 Then
     MsgBox ("Error: " & retcode)
     Exit Sub
   End If
 End If
Next cnt

'Return to original drive
ChDrive Mid$(curpath, 1, 2)

'Return to original path
ChDir curpath

'refresh getfile file box
frmgetfile.filFiles.Refresh

End Sub

'Copyright 1995 by Hitoshi Ozawa
Sub cmdExtract_DragOver (Source As Control, X As Single, Y As Single, State As Integer)

Select Case State
  Case 0
    'change icon to release
     lstLHAcontents.DragIcon = picFile2
  Case 1
    'change icon to release
     lstLHAcontents.DragIcon = picFile1
End Select

End Sub

'Copyright 1995 by Hitoshi Ozawa
Sub cmdOK_Click ()

Dim retcode As Integer
Dim curpath As String

'Check if file selected
If lstLHAcontents.Text = "" Then
  frmLHA.Tag = ""
  frmLHA.Hide
End If

'Save current path
curpath = CurDir

'Change to file's drive and path
ChDrive Mid$(frmgetfile.Tag, 1, 2)
ChDir frmgetfile.filFiles.Path

'Check if file already exists
On Error GoTo ExtFile
 retcode = GetAttr(lstLHAcontents.Text)
 retcode = MsgBox("Overwrite existing file?", 308, "File already exists!")
If retcode = 6 Then
   Kill lstLHAcontents.Text
   GoTo ExtFile
 End If
Exit Sub

ExtFile:
'Create LHA command
cmd = "e " & frmgetfile.Tag & " " & lstLHAcontents.Text

'Perform LHA operation
retcode = lha(cmd, buffer, szbuff)

'Check for error
If retcode <> 0 Then
 MsgBox ("LHA.DLL Error: " & retcode)
 Exit Sub
End If

'Return to original drive
ChDrive Mid$(curpath, 1, 2)

'Return to original path
ChDir curpath

'refresh getfile file box
frmgetfile.filFiles.Refresh

'Assign selection to tag
frmLHA.Tag = lstLHAcontents.Text

frmLHA.Hide

Exit Sub
End Sub

Sub cmdtop_Click ()

'        If VisibleFrame Is Nothing Then
'            frmCallDlls!fraInfo(0).Visible = False
'        Else
'            VisibleFrame.Visible = False
'        End If
'        frmCallDlls!fraInfo(Index + 1).Visible = True
'        Set VisibleFrame = frm